home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / ln03 / rose / ffc.pas < prev    next >
Pascal/Delphi Source File  |  1990-10-01  |  16KB  |  278 lines
  1. {4:}PROGRAM FFC(INPUT,OUTPUT,LN03FILE,PXLFILE,OUTFILE);LABEL{5:}
  2. 9998,9999;{:5}TYPE{6:}EIGHTBITS=0..255;
  3. BYTEBLOCK=PACKED ARRAY[0..511]OF EIGHTBITS;
  4. BYTEFILE=PACKED FILE OF BYTEBLOCK;{:6}VAR{7:}INLINE:VARYING[513]OF CHAR;
  5. ILP,ISTART,ILLEN:INTEGER;VERB:INTEGER;{:7}{11:}LN03FILE:BYTEFILE;
  6. LN03COUNT,LN03LEN,I:INTEGER;
  7. LBUF:PACKED RECORD CASE BOOLEAN OF FALSE:(C:PACKED ARRAY[0..((512*512)-1
  8. )]OF CHAR);TRUE:(B:PACKED ARRAY[0..511]OF BYTEBLOCK);END;{:11}{15:}
  9. PXLFILE:BYTEFILE;PXLCOUNT,PXLLEN:INTEGER;
  10. PBUF:PACKED RECORD CASE BOOLEAN OF FALSE:(C:PACKED ARRAY[0..((512*512)-1
  11. )]OF CHAR);TRUE:(B:PACKED ARRAY[0..511]OF BYTEBLOCK);END;{:15}{22:}
  12. DEFSTART,RASSTART:INTEGER;J,K,L,M,N:INTEGER;
  13. VISIBLEBYTE:PACKED ARRAY[1..8]OF CHAR;{:22}{31:}
  14. CHARXDEFOFFS,STRINGPOOLSI,STRINGXPOOLO:INTEGER;
  15. PSIZE,LSIZE,MSIZE:INTEGER;FIRSTCHAR,LASTCHAR,NUMCHARS:INTEGER;
  16. ALLBLANK:BOOLEAN;ZCHAR,TFMWIDTH,XOFFSET,YOFFSET:INTEGER;DSIZE,MAG:REAL;
  17. {:31}{39:}FONTIDSTRING:PACKED ARRAY[1..31]OF CHAR;{:39}{44:}
  18. POINTS:INTEGER;{:44}{47:}OUTFILE:BYTEFILE;{:47}{8:}
  19. FUNCTION COMMANDVERB:INTEGER;VAR I:INTEGER;BEGIN{9:}
  20. WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1;ISTART:=ILP;
  21. WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1;
  22. FOR I:=ISTART TO ILP-1 DO BEGIN IF(INLINE[I]>='A')AND(INLINE[I]<='Z')
  23. THEN INLINE[I]:=CHR(ORD(INLINE[I])+ORD('a')-ORD('A'))END;{:9}
  24. IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'rln03')=1 THEN COMMANDVERB:=1
  25. ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tln03long')=1 THEN
  26. COMMANDVERB:=3 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),
  27. 'tln03word')=1 THEN COMMANDVERB:=4 ELSE IF INDEX(SUBSTR(INLINE,ISTART,
  28. ILP-ISTART),'tln03')=1 THEN COMMANDVERB:=2 ELSE IF INDEX(SUBSTR(INLINE,
  29. ISTART,ILP-ISTART),'rpxl')=1 THEN COMMANDVERB:=5 ELSE IF INDEX(SUBSTR(
  30. INLINE,ISTART,ILP-ISTART),'tpxllong')=1 THEN COMMANDVERB:=7 ELSE IF
  31. INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxlword')=1 THEN COMMANDVERB:=8
  32. ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'tpxl')=1 THEN
  33. COMMANDVERB:=6 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),'toln03x')
  34. =1 THEN COMMANDVERB:=11 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-ISTART),
  35. 'toln03')=1 THEN COMMANDVERB:=9 ELSE IF INDEX(SUBSTR(INLINE,ISTART,ILP-
  36. ISTART),'wln03')=1 THEN COMMANDVERB:=10 ELSE IF INDEX(SUBSTR(INLINE,
  37. ISTART,ILP-ISTART),'exit')=1 THEN COMMANDVERB:=99 ELSE COMMANDVERB:=0
  38. END;{:8}{19:}FUNCTION GETFIXNUM:INTEGER;LABEL 1;VAR X,X1:INTEGER;
  39. NEGATIVE:BOOLEAN;BEGIN X1:=0;NEGATIVE:=FALSE;
  40. WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1;
  41. IF ILP>ILLEN THEN GOTO 1;IF INLINE[ILP]='-'THEN BEGIN NEGATIVE:=TRUE;
  42. ILP:=ILP+1 END;
  43. IF(ILP>ILLEN)OR(INLINE[ILP]<'0')OR(INLINE[ILP]>'9')THEN GOTO 1;X1:=0;
  44. WHILE(INLINE[ILP]>='0')AND(INLINE[ILP]<='9')DO BEGIN X1:=10*X1+ORD(
  45. INLINE[ILP])-ORD('0');ILP:=ILP+1;IF ILP>ILLEN THEN GOTO 1;END;1:X:=X1;
  46. IF NEGATIVE THEN X:=-X;GETFIXNUM:=X END;{:19}{25:}
  47. PROCEDURE BINREP(V:INTEGER);VAR CNT,REM,QUO:INTEGER;
  48. BEGIN VISIBLEBYTE:='........';QUO:=V;
  49. FOR CNT:=1 TO 8 DO BEGIN REM:=QUO MOD 2;QUO:=QUO DIV 2;
  50. IF REM<>0 THEN VISIBLEBYTE[CNT]:='B'END;END;{:25}{27:}
  51. PROCEDURE REVBINREP(V:INTEGER);VAR CNT,REM,QUO:INTEGER;
  52. BEGIN VISIBLEBYTE:='........';QUO:=V;
  53. FOR CNT:=1 TO 8 DO BEGIN REM:=QUO MOD 2;QUO:=QUO DIV 2;
  54. IF REM<>0 THEN VISIBLEBYTE[9-CNT]:='B'END;END;{:27}{34:}
  55. FUNCTION SIGNEDPXLWOR(INDEX:INTEGER):INTEGER;
  56. BEGIN IF ORD(PBUF.C[INDEX])>=128 THEN SIGNEDPXLWOR:=(ORD(PBUF.C[(INDEX)
  57. +1])+256*ORD(PBUF.C[INDEX]))-65536 ELSE SIGNEDPXLWOR:=(ORD(PBUF.C[(INDEX
  58. )+1])+256*ORD(PBUF.C[INDEX]))END;
  59. PROCEDURE SETLN03LONG(INDEX,VALUE:INTEGER);VAR NEGATIVE:BOOLEAN;
  60. A,B,C,D,CARRY:INTEGER;
  61. BEGIN IF VALUE<0 THEN NEGATIVE:=TRUE ELSE NEGATIVE:=FALSE;
  62. IF NEGATIVE THEN VALUE:=-VALUE;A:=VALUE MOD 256;
  63. B:=(VALUE DIV 256)MOD 256;C:=(VALUE DIV(256*256))MOD 256;
  64. D:=VALUE DIV(256*256*256);IF NEGATIVE THEN BEGIN CARRY:=0;A:=256-A;
  65. IF A=256 THEN BEGIN A:=0;CARRY:=1 END;B:=255+CARRY-B;
  66. IF B=256 THEN B:=0 ELSE CARRY:=0;C:=255+CARRY-C;
  67. IF C=256 THEN C:=0 ELSE CARRY:=0;D:=255+CARRY-D;IF D=256 THEN D:=0 END;
  68. LBUF.C[INDEX]:=CHR(A);LBUF.C[INDEX+1]:=CHR(B);LBUF.C[INDEX+2]:=CHR(C);
  69. LBUF.C[INDEX+3]:=CHR(D)END;{:34}{36:}FUNCTION REVERSEBYTE(U:CHAR):CHAR;
  70. VAR CNT,RV:INTEGER;BEGIN BINREP(ORD(U));RV:=0;
  71. FOR CNT:=1 TO 8 DO IF VISIBLEBYTE[CNT]='B'THEN RV:=1+2*RV ELSE RV:=2*RV;
  72. REVERSEBYTE:=CHR(RV)END;{:36}
  73. BEGIN WRITELN('Font File Converter, Version 3');WRITELN;{10:}
  74. 9998:WRITELN;WRITE('FFC>');READLN(INLINE);
  75. IF LENGTH(INLINE)=513 THEN BEGIN WRITELN('Command line too long');
  76. GOTO 9998 END;INLINE:=INLINE+' ';ILP:=1;ILLEN:=LENGTH(INLINE);
  77. VERB:=COMMANDVERB;IF VERB=0 THEN BEGIN WRITELN('No such command');
  78. GOTO 9998 END ELSE{12:}
  79. IF VERB=1 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=ILP+1;
  80. ISTART:=ILP;WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1;
  81. OPEN(LN03FILE,SUBSTR(INLINE,ISTART,ILP-ISTART),readonly,error:=continue)
  82. ;IF STATUS(LN03FILE)>0 THEN BEGIN WRITELN('Couldn''t open file');
  83. GOTO 9998 END;RESET(LN03FILE);{13:}LN03COUNT:=0;
  84. WHILE(NOT EOF(LN03FILE))AND(LN03COUNT<512)DO BEGIN READ(LN03FILE,LBUF.B[
  85. LN03COUNT]);LN03COUNT:=LN03COUNT+1;END;LN03LEN:=LN03COUNT*512;
  86. CLOSE(LN03FILE);{14:}IF LN03LEN<16 THEN WRITELN('LN03 file too short');
  87. IF(LBUF.C[4]<>'F')OR(LBUF.C[5]<>'O')OR(LBUF.C[6]<>'N')OR(LBUF.C[7]<>'T')
  88. THEN WRITELN('Second longword not FONT'){:14}{:13}END{:12}{16:}
  89. ELSE IF VERB=5 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
  90. ILP+1;ISTART:=ILP;WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1;
  91. OPEN(PXLFILE,SUBSTR(INLINE,ISTART,ILP-ISTART),readonly,error:=continue);
  92. IF STATUS(PXLFILE)>0 THEN BEGIN WRITELN('Couldn''t open file');
  93. GOTO 9998 END;RESET(PXLFILE);{17:}PXLCOUNT:=0;
  94. WHILE(NOT EOF(PXLFILE))AND(PXLCOUNT<512)DO BEGIN READ(PXLFILE,PBUF.B[
  95. PXLCOUNT]);PXLCOUNT:=PXLCOUNT+1;END;PXLLEN:=PXLCOUNT*512;CLOSE(PXLFILE);
  96. {18:}
  97. IF NOT(PXLLEN MOD 4=0)THEN WRITELN('PXL file length not multiple of 4');
  98. IF(ORD(PBUF.C[(0)+3])+(256*(ORD(PBUF.C[(0)+2])+256*(ORD(PBUF.C[(0)+1])
  99. +256*ORD(PBUF.C[0])))))<>1001 THEN WRITELN('Initial PXL format id wrong'
  100. );I:=PXLLEN-4;
  101. WHILE(I>=PXLLEN-512)DO BEGIN IF(ORD(PBUF.C[(I)+3])+(256*(ORD(PBUF.C[(I)
  102. +2])+256*(ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I])))))=1001 THEN BEGIN
  103. PXLLEN:=I+4;I:=-1 END ELSE I:=I-4 END;
  104. IF PXLLEN<16 THEN WRITELN('PXL file too short');
  105. IF(ORD(PBUF.C[(PXLLEN-4)+3])+(256*(ORD(PBUF.C[(PXLLEN-4)+2])+256*(ORD(
  106. PBUF.C[(PXLLEN-4)+1])+256*ORD(PBUF.C[PXLLEN-4])))))<>1001 THEN WRITELN(
  107. 'Final PXL format id wrong');{:18}{:17}END{:16}{21:}
  108. ELSE IF VERB=2 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
  109. ILP+1;
  110. IF ILP>ILLEN THEN BEGIN WRITELN('You have to say what character to type'
  111. );GOTO 9998 END;
  112. IF(INLINE[ILP]='''')AND(ILP<ILLEN)THEN I:=ORD(INLINE[ILP+1])ELSE I:=
  113. GETFIXNUM;
  114. IF(I<(ORD(LBUF.C[164])+(256*(ORD(LBUF.C[(164)+1])+256*(ORD(LBUF.C[(164)
  115. +2])+256*ORD(LBUF.C[(164)+3]))))))OR(I>(ORD(LBUF.C[168])+(256*(ORD(LBUF.
  116. C[(168)+1])+256*(ORD(LBUF.C[(168)+2])+256*ORD(LBUF.C[(168)+3]))))))THEN
  117. BEGIN WRITELN('No such character');GOTO 9998 END;
  118. I:=4*(I-(ORD(LBUF.C[164])+(256*(ORD(LBUF.C[(164)+1])+256*(ORD(LBUF.C[(
  119. 164)+2])+256*ORD(LBUF.C[(164)+3]))))))+(ORD(LBUF.C[120])+(256*(ORD(LBUF.
  120. C[(120)+1])+256*(ORD(LBUF.C[(120)+2])+256*ORD(LBUF.C[(120)+3])))));{23:}
  121. IF LBUF.C[I+3]>=CHR(128)THEN BEGIN WRITELN(
  122. 'Indirect locators not supported');GOTO 9998 END;
  123. DEFSTART:=ORD(LBUF.C[I])+256*(ORD(LBUF.C[I+1])+256*ORD(LBUF.C[(I+1)+1]))
  124. ;IF DEFSTART=0 THEN BEGIN WRITELN('Locator is zero');GOTO 9998 END;
  125. RASSTART:=DEFSTART+(ORD(LBUF.C[200])+(256*(ORD(LBUF.C[(200)+1])+256*(ORD
  126. (LBUF.C[(200)+2])+256*ORD(LBUF.C[(200)+3])))));
  127. WRITELN(' ma = ',RASSTART:1);
  128. IF RASSTART>((512*512)-1)THEN BEGIN WRITELN(
  129. 'Character outside piece of file read');GOTO 9998 END{:23};{24:}
  130. WRITELN('width ',(((ORD(LBUF.C[DEFSTART+4])+(256*(ORD(LBUF.C[(DEFSTART+4
  131. )+1])+256*(ORD(LBUF.C[(DEFSTART+4)+2])+256*ORD(LBUF.C[(DEFSTART+4)+3])))
  132. )))/24.0):5:1,' pixels');
  133. IF ORD(LBUF.C[RASSTART+1])<>129 THEN BEGIN WRITELN(
  134. 'Run length encoding not supported');GOTO 9998 END;
  135. IF ODD(ORD(LBUF.C[RASSTART]))THEN BEGIN WRITELN('landscape');
  136. I:=(ORD(LBUF.C[RASSTART+4])+256*ORD(LBUF.C[(RASSTART+4)+1]));
  137. J:=(ORD(LBUF.C[RASSTART+6])+256*ORD(LBUF.C[(RASSTART+6)+1]))END ELSE
  138. BEGIN WRITELN('portrait');
  139. I:=(ORD(LBUF.C[RASSTART+6])+256*ORD(LBUF.C[(RASSTART+6)+1]));
  140. J:=(ORD(LBUF.C[RASSTART+4])+256*ORD(LBUF.C[(RASSTART+4)+1]))END;
  141. WRITELN(I:1,' rows ',J:1,' columns');K:=I DIV 8;IF I<>8*K THEN K:=K+1;
  142. FOR L:=0 TO J-1 DO BEGIN FOR M:=0 TO K-1 DO BEGIN BINREP(ORD(LBUF.C[
  143. RASSTART+8+K*L+M]));WRITE(VISIBLEBYTE)END;WRITELN END{:24}END{:21}{26:}
  144. ELSE IF VERB=6 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
  145. ILP+1;
  146. IF ILP>ILLEN THEN BEGIN WRITELN('You have to say what character to type'
  147. );GOTO 9998 END;
  148. IF(INLINE[ILP]='''')AND(ILP<ILLEN)THEN I:=ORD(INLINE[ILP+1])ELSE I:=
  149. GETFIXNUM;IF(I<0)OR(I>127)THEN BEGIN WRITELN('No such character');
  150. GOTO 9998 END;DEFSTART:=PXLLEN-4*517+16*I;
  151. RASSTART:=4*(ORD(PBUF.C[(DEFSTART+8)+3])+(256*(ORD(PBUF.C[(DEFSTART+8)+2
  152. ])+256*(ORD(PBUF.C[(DEFSTART+8)+1])+256*ORD(PBUF.C[DEFSTART+8])))));
  153. WRITELN(' rasters at ',RASSTART:1);
  154. IF RASSTART>PXLLEN THEN BEGIN WRITELN('Rasters outside file');
  155. GOTO 9998 END;I:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART]));
  156. J:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2]));
  157. WRITELN(I:1,' columns ',J:1,' rows');K:=I DIV 32;IF I<>32*K THEN K:=K+1;
  158. FOR L:=0 TO J-1 DO BEGIN FOR M:=0 TO K-1 DO BEGIN REVBINREP(ORD(PBUF.C[
  159. RASSTART+4*K*L+4*M]));WRITE(VISIBLEBYTE);
  160. REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+1]));WRITE(VISIBLEBYTE);
  161. REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+2]));WRITE(VISIBLEBYTE);
  162. REVBINREP(ORD(PBUF.C[RASSTART+4*K*L+4*M+3]));WRITE(VISIBLEBYTE)END;
  163. WRITELN END END{:26}{28:}ELSE IF VERB=3 THEN BEGIN I:=GETFIXNUM;
  164. IF(I>=0)AND(I<LN03LEN)THEN WRITELN((ORD(LBUF.C[I])+(256*(ORD(LBUF.C[(I)
  165. +1])+256*(ORD(LBUF.C[(I)+2])+256*ORD(LBUF.C[(I)+3]))))):1)ELSE WRITELN(
  166. 'Location not in file')END ELSE IF VERB=4 THEN BEGIN I:=GETFIXNUM;
  167. IF(I>=0)AND(I<LN03LEN)THEN WRITELN((ORD(LBUF.C[I])+256*ORD(LBUF.C[(I)+1]
  168. )))ELSE WRITELN('Location not in file')END ELSE IF VERB=7 THEN BEGIN I:=
  169. GETFIXNUM;
  170. IF(I>=0)AND(I<PXLLEN)THEN WRITELN((ORD(PBUF.C[(I)+3])+(256*(ORD(PBUF.C[(
  171. I)+2])+256*(ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I]))))):1)ELSE WRITELN(
  172. 'Location not in file')END ELSE IF VERB=8 THEN BEGIN I:=GETFIXNUM;
  173. IF(I>=0)AND(I<PXLLEN)THEN WRITELN((ORD(PBUF.C[(I)+1])+256*ORD(PBUF.C[I])
  174. ))ELSE WRITELN('Location not in file')END{:28}{30:}
  175. ELSE IF(VERB=9)OR(VERB=11)THEN BEGIN FOR I:=0 TO((512*512)-1)DO LBUF.C[I
  176. ]:=CHR(0);IF VERB=9 THEN BEGIN FIRSTCHAR:=33;
  177. LASTCHAR:=126 END ELSE BEGIN FIRSTCHAR:=0;LASTCHAR:=127 END;
  178. NUMCHARS:=LASTCHAR-FIRSTCHAR+1;{32:}STRINGPOOLSI:=48;
  179. STRINGXPOOLO:=480+4*NUMCHARS+4;CHARXDEFOFFS:=STRINGXPOOLO+STRINGPOOLSI;
  180. LN03LEN:=CHARXDEFOFFS;PSIZE:=0;LSIZE:=0;MSIZE:=0;
  181. FOR ZCHAR:=FIRSTCHAR TO LASTCHAR DO BEGIN{33:}
  182. LBUF.C[LN03LEN+3]:=CHR(128);DEFSTART:=PXLLEN-4*517+16*ZCHAR;
  183. RASSTART:=4*(ORD(PBUF.C[(DEFSTART+8)+3])+(256*(ORD(PBUF.C[(DEFSTART+8)+2
  184. ])+256*(ORD(PBUF.C[(DEFSTART+8)+1])+256*ORD(PBUF.C[DEFSTART+8])))));
  185. IF RASSTART>PXLLEN THEN BEGIN WRITELN('Rasters outside file for ',ZCHAR:
  186. 1);GOTO 9998 END;
  187. TFMWIDTH:=(ORD(PBUF.C[(DEFSTART+12)+3])+(256*(ORD(PBUF.C[(DEFSTART+12)+2
  188. ])+256*(ORD(PBUF.C[(DEFSTART+12)+1])+256*ORD(PBUF.C[DEFSTART+12])))));
  189. DSIZE:=(ORD(PBUF.C[(PXLLEN-12)+3])+(256*(ORD(PBUF.C[(PXLLEN-12)+2])+256*
  190. (ORD(PBUF.C[(PXLLEN-12)+1])+256*ORD(PBUF.C[PXLLEN-12])))));
  191. MAG:=(ORD(PBUF.C[(PXLLEN-16)+3])+(256*(ORD(PBUF.C[(PXLLEN-16)+2])+256*(
  192. ORD(PBUF.C[(PXLLEN-16)+1])+256*ORD(PBUF.C[PXLLEN-16])))));
  193. DSIZE:=(DSIZE/(1048576))*(MAG/1500.0);XOFFSET:=SIGNEDPXLWOR(DEFSTART+4);
  194. YOFFSET:=SIGNEDPXLWOR(DEFSTART+6);
  195. SETLN03LONG(LN03LEN+4,ROUND((DSIZE*7200.0*TFMWIDTH)/((1048576)*72.27)));
  196. SETLN03LONG(LN03LEN+8,-24*XOFFSET);SETLN03LONG(LN03LEN+12,-24*YOFFSET);
  197. {:33}{35:}LBUF.C[LN03LEN+17]:=CHR(129);
  198. I:=(ORD(PBUF.C[(DEFSTART)+1])+256*ORD(PBUF.C[DEFSTART]));
  199. J:=(ORD(PBUF.C[(DEFSTART+2)+1])+256*ORD(PBUF.C[DEFSTART+2]));
  200. ALLBLANK:=(I=0)AND(J=0);IF ALLBLANK THEN BEGIN I:=1;J:=1 END;
  201. LBUF.C[LN03LEN+20]:=CHR(J MOD 256);LBUF.C[LN03LEN+21]:=CHR(J DIV 256);
  202. LBUF.C[LN03LEN+22]:=CHR(I MOD 256);LBUF.C[LN03LEN+23]:=CHR(I DIV 256);
  203. K:=I DIV 32;IF I<>32*K THEN K:=K+1;N:=I DIV 8;IF I<>8*N THEN N:=N+1;
  204. IF NOT ALLBLANK THEN FOR L:=0 TO J-1 DO FOR M:=0 TO N-1 DO LBUF.C[
  205. LN03LEN+24+N*L+M]:=REVERSEBYTE(PBUF.C[RASSTART+4*K*L+M]);
  206. SETLN03LONG(480+4*(ZCHAR-FIRSTCHAR),LN03LEN);LN03LEN:=LN03LEN+24+J*N;
  207. IF ODD(LN03LEN)THEN LN03LEN:=LN03LEN+1;PSIZE:=PSIZE+J*N;K:=J DIV 8;
  208. IF J<>8*K THEN K:=K+1;LSIZE:=LSIZE+I*K;
  209. IF I*K>J*N THEN MSIZE:=MSIZE+I*K ELSE MSIZE:=MSIZE+J*N;{:35}END;{:32};
  210. {37:}IF LN03LEN MOD 4<>0 THEN LN03LEN:=LN03LEN+(4-(LN03LEN MOD 4));
  211. LN03LEN:=LN03LEN+8;SETLN03LONG(0,LN03LEN);
  212. SETLN03LONG(LN03LEN-8,LN03LEN);LBUF.C[4]:='F';LBUF.C[LN03LEN-4]:='F';
  213. LBUF.C[5]:='O';LBUF.C[LN03LEN-3]:='O';LBUF.C[6]:='N';
  214. LBUF.C[LN03LEN-2]:='N';LBUF.C[7]:='T';LBUF.C[LN03LEN-1]:='T';{:37}{38:}
  215. LBUF.C[8]:=CHR(1);LBUF.C[12]:=CHR(31);LBUF.C[16]:=CHR(20);
  216. FONTIDSTRING:='U000000002SK00GG0001UZZZZ02F000';
  217. FOR I:=1 TO 31 DO LBUF.C[20+I-1]:=FONTIDSTRING[I];
  218. LBUF.C[88]:=CHR(1973 MOD 256);LBUF.C[89]:=CHR(1973 DIV 256);
  219. LBUF.C[90]:=CHR(9);LBUF.C[92]:=CHR(11);LBUF.C[94]:=CHR(14);{:38}{40:}
  220. SETLN03LONG(100,104);SETLN03LONG(104,252);SETLN03LONG(108,124);
  221. SETLN03LONG(112,356);SETLN03LONG(116,4*NUMCHARS);SETLN03LONG(120,480);
  222. SETLN03LONG(124,4);SETLN03LONG(128,480+4*NUMCHARS);
  223. SETLN03LONG(136,480+4*NUMCHARS+4);SETLN03LONG(140,STRINGPOOLSI);
  224. SETLN03LONG(144,480+4*NUMCHARS+4);
  225. SETLN03LONG(152,480+4*NUMCHARS+4+STRINGPOOLSI);
  226. SETLN03LONG(156,LN03LEN-8-CHARXDEFOFFS);SETLN03LONG(160,CHARXDEFOFFS);
  227. {:40}{41:}SETLN03LONG(164,FIRSTCHAR);SETLN03LONG(168,LASTCHAR);
  228. SETLN03LONG(192,32);SETLN03LONG(196,168);SETLN03LONG(200,16);
  229. SETLN03LONG(204,NUMCHARS);SETLN03LONG(212,NUMCHARS);
  230. SETLN03LONG(220,NUMCHARS);SETLN03LONG(228,PSIZE);SETLN03LONG(232,LSIZE);
  231. SETLN03LONG(236,MSIZE);{:41}{42:}SETLN03LONG(252,2);SETLN03LONG(256,7);
  232. SETLN03LONG(260,STRINGXPOOLO);LBUF.C[STRINGXPOOLO]:='0';
  233. LBUF.C[STRINGXPOOLO+1]:='B';LBUF.C[STRINGXPOOLO+2]:=CHR(9);
  234. LBUF.C[STRINGXPOOLO+3]:='Z';LBUF.C[STRINGXPOOLO+4]:='Z';
  235. LBUF.C[STRINGXPOOLO+5]:='Z';LBUF.C[STRINGXPOOLO+6]:='Z';
  236. SETLN03LONG(264,7);SETLN03LONG(268,STRINGXPOOLO+7);
  237. FOR I:=1 TO 7 DO LBUF.C[STRINGXPOOLO+7+I-1]:=FONTIDSTRING[I];
  238. SETLN03LONG(272,16);SETLN03LONG(276,STRINGXPOOLO+14);
  239. FOR I:=1 TO 16 DO LBUF.C[STRINGXPOOLO+14+I-1]:=' ';SETLN03LONG(280,16);
  240. SETLN03LONG(284,STRINGXPOOLO+30);
  241. FOR I:=1 TO 16 DO LBUF.C[STRINGXPOOLO+30+I-1]:=FONTIDSTRING[I];{:42}
  242. {43:}
  243. I:=(ORD(PBUF.C[(PXLLEN-12)+3])+(256*(ORD(PBUF.C[(PXLLEN-12)+2])+256*(ORD
  244. (PBUF.C[(PXLLEN-12)+1])+256*ORD(PBUF.C[PXLLEN-12])))));
  245. POINTS:=I DIV(1048576);K:=(10000*I MOD(1048576))DIV(1048576);
  246. LBUF.C[304]:=CHR(POINTS MOD 256);LBUF.C[305]:=CHR(POINTS DIV 256);
  247. LBUF.C[306]:=CHR(K MOD 256);LBUF.C[307]:=CHR(K DIV 256);
  248. IF K>4999 THEN POINTS:=POINTS+1;SETLN03LONG(308,50*POINTS);{:43}{45:}
  249. LBUF.C[314]:=CHR(24);LBUF.C[316]:=CHR(16);LBUF.C[320]:=CHR(16);
  250. LBUF.C[324]:=CHR(1);LBUF.C[326]:=CHR(1);LBUF.C[328]:=CHR(1);
  251. LBUF.C[330]:=CHR(1);LBUF.C[334]:=CHR(1);{:45}{46:}
  252. SETLN03LONG(360,12*POINTS);SETLN03LONG(364,8*POINTS);
  253. SETLN03LONG(368,-25*POINTS);SETLN03LONG(372,8*POINTS);
  254. SETLN03LONG(376,-60*POINTS);SETLN03LONG(380,8*POINTS);
  255. LBUF.C[386]:=CHR(1);LBUF.C[390]:=CHR(POINTS*12 MOD 256);
  256. LBUF.C[391]:=CHR(POINTS*12 DIV 256);SETLN03LONG(392,-36*POINTS);
  257. SETLN03LONG(400,16*POINTS);SETLN03LONG(408,24*POINTS);
  258. SETLN03LONG(412,20*POINTS);SETLN03LONG(416,80*POINTS);
  259. SETLN03LONG(420,25*POINTS);SETLN03LONG(424,100*POINTS);
  260. SETLN03LONG(428,50*POINTS);SETLN03LONG(432,10*POINTS);
  261. SETLN03LONG(436,35*POINTS);SETLN03LONG(440,-64*POINTS);
  262. SETLN03LONG(444,-50*POINTS);SETLN03LONG(448,-35*POINTS);
  263. SETLN03LONG(452,100*POINTS);SETLN03LONG(456,-65*POINTS);
  264. SETLN03LONG(460,35*POINTS);SETLN03LONG(464,65*POINTS);
  265. SETLN03LONG(468,35*POINTS);SETLN03LONG(472,10*POINTS);
  266. SETLN03LONG(476,10*POINTS);{:46}END{:30}{48:}
  267. ELSE IF VERB=10 THEN BEGIN WHILE(ILP<=ILLEN)AND(INLINE[ILP]=' ')DO ILP:=
  268. ILP+1;
  269. IF ILP>ILLEN THEN BEGIN WRITELN('You must specify a file to write into')
  270. ;GOTO 9998 END;ISTART:=ILP;
  271. WHILE(ILP<=ILLEN)AND(INLINE[ILP]<>' ')DO ILP:=ILP+1;
  272. OPEN(OUTFILE,SUBSTR(INLINE,ISTART,ILP-ISTART),error:=continue);
  273. IF STATUS(OUTFILE)<>0 THEN BEGIN WRITELN('couldn''t open',SUBSTR(INLINE,
  274. ISTART,ILP-ISTART));GOTO 9998 END;REWRITE(OUTFILE);I:=LN03LEN DIV 512;
  275. IF LN03LEN<>I*512 THEN I:=I+1;
  276. FOR J:=0 TO I-1 DO WRITE(OUTFILE,LBUF.B[J]);CLOSE(OUTFILE)END{:48}{49:}
  277. ELSE IF VERB=99 THEN GOTO 9999{:49};GOTO 9998;9999:{:10}END.{:4}
  278.